home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / win / framer10.zip / RLE&MMP.BAS < prev    next >
BASIC Source File  |  1994-02-01  |  3KB  |  119 lines
  1. zefile$ = DIR$("*.tga")
  2. how% = 0
  3. DO UNTIL zefile$ = ""
  4.     zefile$ = LEFT$(zefile$, INSTR(zefile$, ".") - 1)
  5.     how% = how% + 1
  6.     CLS
  7.     PRINT "Run Length Encoding of 24 bit Targa: "; zefile$
  8.     PRINT "File #"; how%
  9.     OPEN zefile$ + ".tga" FOR BINARY AS #1
  10.     x$ = "  "
  11.     y$ = "  "
  12.     z$ = " "
  13.     aver@ = 0
  14.     aveg@ = 0
  15.     aveb@ = 0
  16.     ave@ = 0
  17.     GET #1, 13, x$
  18.     GET #1, 15, y$
  19.     GET #1, 18, z$
  20.     x% = CVI(x$)
  21.     y% = CVI(y$)
  22.     PRINT "Total X   ="; x%
  23.     PRINT "      Y   ="; y%
  24.     PRINT "Direction = ";
  25.     IF ASC(z$) = 32 THEN
  26.       PRINT "Forward"
  27.     ELSE
  28.       PRINT "Reverse"
  29.     END IF
  30.     PRINT STRING$(80, "-")
  31.     IF x% MOD 4 = 0 THEN
  32.       OPEN zefile$ + ".rle" FOR OUTPUT AS #2
  33.       CLOSE 2
  34.       OPEN zefile$ + ".rle" FOR BINARY AS #2
  35.       l@ = LOF(1) - (x% * 3) + 1
  36.       B$ = SPACE$(x% * 3)
  37.       Rle@ = 1
  38.       IF ASC(z$) = 32 THEN
  39.         start@ = 19
  40.         ender@ = l@
  41.         steper@ = x% * 3
  42.       ELSE
  43.         start@ = l@
  44.         ender@ = 19
  45.         steper@ = -x% * 3
  46.       END IF
  47.       FOR q@ = start@ TO ender@ STEP steper@
  48.         GET #1, q@, B$
  49.         Black% = 0
  50.         Part% = 0
  51.         Org% = 0
  52.         FOR P% = 1 TO x% * 3 STEP 12
  53.           state% = 0
  54.           mask% = 15
  55.           FOR r% = 0 TO 11 STEP 3
  56.             IF ASC(MID$(B$, P% + r%, 1)) < 15 AND ASC(MID$(B$, P% + r% + 1, 1)) < 15 AND ASC(MID$(B$, P% + r% + 2, 1)) < 15 THEN
  57.               state% = state% + 1
  58.               mask% = mask% - 2 ^ (3 - (r% / 3))
  59.             ELSE
  60.               aveb@ = aveb@ + ASC(MID$(B$, P% + r%, 1))
  61.               aveg@ = aveg@ + ASC(MID$(B$, P% + r% + 1, 1))
  62.               aver@ = aver@ + ASC(MID$(B$, P% + r% + 2, 1))
  63.               ave@ = ave@ + 1
  64.             END IF
  65.           NEXT r%
  66.           IF state% = 4 THEN
  67.             IF Part% <> 0 OR Org% <> 0 THEN GOSUB saveit
  68.             Black% = Black% + 1
  69.           ELSEIF state% <> 0 THEN
  70.             IF Black% <> 0 OR Org% <> 0 THEN GOSUB saveit
  71.             Rle$ = "P" + CHR$(mask%)
  72.             PUT #2, Rle@, Rle$
  73.             Rle@ = Rle@ + 2
  74.           ELSE
  75.             IF Part% <> 0 OR Black% <> 0 THEN GOSUB saveit
  76.             Org% = Org% + 1
  77.           END IF
  78.         NEXT P%
  79.         IF Black% <> 0 OR Part% <> 0 OR Org% <> 0 THEN GOSUB saveit
  80.       NEXT q@
  81.       CLOSE
  82.       PRINT
  83.       SHELL "trg2mmp " + zefile$ + ".tga " + zefile$ + ".mmp"
  84.       OPEN zefile$ + ".rgb" FOR OUTPUT AS #3
  85.       PRINT #3, aver@ \ ave@
  86.       PRINT #3, aveg@ \ ave@
  87.       PRINT #3, aveb@ \ ave@
  88.       PRINT #3, 100
  89.       PRINT #3, 100
  90.     END IF
  91.     CLOSE
  92.     zefile$ = DIR$
  93. LOOP
  94.  
  95. END
  96.     
  97. saveit:
  98.       IF Black% <> 0 THEN
  99.         Rle$ = "B" + CHR$(Black%)
  100.         PUT #2, Rle@, Rle$
  101.         Rle@ = Rle@ + 2
  102.       END IF
  103.       IF Part% <> 0 THEN
  104.         Rle$ = "P" + CHR$(Part%)
  105.         PUT #2, Rle@, Rle$
  106.         Rle@ = Rle@ + 2
  107.       END IF
  108.       IF Org% <> 0 THEN
  109.         Rle$ = "O" + CHR$(Org%)
  110.         PUT #2, Rle@, Rle$
  111.         Rle@ = Rle@ + 2
  112.       END IF
  113.       T@ = T@ + Black% + Part% + Org%
  114.       Black% = 0
  115.       Part% = 0
  116.       Org% = 0
  117.       RETURN
  118.  
  119.